PC-X 1997 October/pcx14_9710.iso/swag/delphi.swg/0189_Component to display while waiting.pas

Pascal/Delphi Source File | 1996-11-29 | 9.0 KB | 366 lines

{
After I got the new Swag-snippets and saw how to make components for
Delphi, I just made this one for fun.

You all still remember Knight Rider with his car, KITT... Well, at the
front the car had a scanner... I made it as a component...

All properties are as obvious as can be (I think) so that shouldn't be a
problem. Just install it as normal (Don't forget to make a bitmap for
it!)

Remember, it's just for fun. Use it when scanning something or waiting
for something...

Author: Martijn Tonies
Date    : 10-28-1996

E-mail: [e-mail]

{---8<------------------------------------------------------------------------}

unit UKITScan;

interface

uses
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
    Forms, Dialogs, ExtCtrls;

const
    MaxLeds = 100;

type
    TScanColor = (scBlue,scGreen,scRed,scYellow);
    TScanMode  = (smLeftToRight,smRightToLeft,smBoth);

    TKITScanner = class(TGraphicControl)
    private
        FBevelInner:    TPanelBevel;
        FBevelOuter:    TPanelBevel;
        FBevelWidth:    Byte;
        FHowManyLeds: Byte;
        FOutColor:      TColor;
        FOnColor:       TColor;
        FScanColor:     TScanColor;
        FScanSpeed:     Integer;
        FScanning:      Boolean;
        FScanMode:      TScanMode;
        FLedsColors:    array [1..MaxLeds] of TScanColor;

        LedPos:             Byte;
        LedWay:             Boolean;
        Border:             Byte;
        LedH,LedW:      Integer;
        LedX:               array [1..MaxLeds] of Integer;
        ScanTimer:      TTimer;
        procedure DoScan(Sender: TObject);
        procedure Draw;
        procedure DrawBevel(Rect: TRect);
        procedure DrawLeds;
        procedure SetBevelInner(Value: TPanelBevel);
        procedure SetBevelOuter(Value: TPanelBevel);
        procedure SetBevelWidth(Value: Byte);
        procedure SetHowManyLeds(Value: Byte);
        procedure SetScanColor(Value: TScanColor);
        procedure SetScanMode(Value: TScanMode);
        procedure SetScanning(Value: Boolean);
        procedure SetScanSpeed(Value: Integer);
        procedure UpdateBorder;
        procedure UpdatePos;
        { Private declarations }
    protected

        { Protected declarations }
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        procedure Paint; override;
        { Public declarations }
    published
        property Align;
        property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone;
        property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvRaised;
        property BevelWidth: Byte read FBevelWidth write SetBevelWidth default 1;
        property Color;
        property Cursor;
        property Enabled;
        property HowManyLeds: Byte read FHowManyLeds write SetHowManyLeds default 7;
        property ScanColor: TScanColor read FScanColor write SetScanColor default scRed;
        property ScanMode: TScanMode read FScanMode write SetScanMode default smBoth;
        property Scanning: Boolean read FScanning write SetScanning default False;
        property ScanSpeed: Integer read FScanSpeed write SetScanSpeed default 100;
        property ShowHint;
        property Visible;
        { Published declarations }
    end;

procedure Register;

implementation
{==============================================================================}
{Private functions and procedures}
procedure TKITScanner.Draw;
var R: TRect;
begin
    R:=GetClientRect;
    UpdateBorder;
    Drawbevel(R);

    InflateRect(R,-Border,-Border);
    Canvas.Brush.Style:=bsSolid;
    Canvas.Brush.Color:=Color;
    Canvas.FillRect(R);

    DrawLeds;
end;
{------------------}
procedure TKITScanner.DrawBevel(Rect: TRect);
var
    TopColor: TColor;
    BottomColor: TColor;

    procedure SetColors(Bevel: TPanelBevel);
    begin
        if Bevel=bvLowered
        then TopColor:=clBtnShadow
        else TopColor:=clBtnHighlight;
        if Bevel=bvLowered
        then BottomColor:=clBtnHighlight
        else BottomColor:=clBtnShadow;
    end;

begin
    if FBevelOuter<>bvNone
    then begin
                 SetColors(FBevelOuter);
                 Frame3D(Canvas,Rect,TopColor,BottomColor,FBevelWidth);
             end;
    if FBevelInner<>bvNone
    then begin
                 SetColors(FBevelInner);
                 Frame3D(Canvas,Rect,TopColor,BottomColor,FBevelWidth);
             end;
end;
{------------------}
procedure TKITScanner.SetBevelInner(Value: TPanelBevel);
begin
    if Value<>FBevelInner
    then begin
                 FBevelInner:=Value;
                 Draw;
             end;
end;
procedure TKITScanner.SetBevelOuter(Value: TPanelBevel);
begin
    if Value<>FBevelOuter
    then begin
                 FBevelOuter:=Value;
                 Draw;
             end;
end;
procedure TKITScanner.SetBevelWidth(Value: Byte);
begin
    if Value<>FBevelWidth
    then begin
                 FBevelWidth:=Value;
                 Draw;
             end;
end;
procedure TKITScanner.UpdateBorder;
begin
    Border:=0;
    if FBevelInner<>bvNone
    then Border:=FBevelWidth;
    if FBevelOuter<>bvNone
    then Inc(Border,FBevelWidth);
end;
{------------------}
procedure TKITScanner.SetHowManyLeds(Value: Byte);
begin
    if Value=0
    then Value:=1;
    if Value>MaxLeds
    then Value:=MaxLeds;
    if FHowManyLeds<>Value
    then begin
                 FHowManyLeds:=Value;
                 Draw;
             end;
end;
{------------------}
procedure TKITScanner.SetScanMode(Value: TScanMode);
begin
    if Value<>FScanMode
    then FScanMode:=Value;
end;
{------------------}
procedure TKITScanner.SetScanSpeed(Value: Integer);
begin
    if Value<>FScanSpeed
    then FScanSpeed:=Value;
    if FScanning and Assigned(ScanTimer)
    then ScanTimer.Interval:=FScanSpeed;
end;
{------------------}
procedure TKITScanner.SetScanColor(Value: TScanColor);
begin
    if Value<>FScanColor
    then begin
                 FScanColor:=Value;
                 Draw;
             end;
end;
{------------------}
procedure TKITScanner.SetScanning(Value: Boolean);
begin
    if Value<>FScanning
    then begin
                 FScanning:=Value;
                 if FScanning
                 then begin
                                ScanTimer:=TTimer.Create(Self);
                                ScanTimer.Interval:=FScanSpeed;
                                ScanTimer.OnTimer:=DoScan;
                                ScanTimer.Enabled:=True;
                            end
                 else if Assigned(ScanTimer)
                            then begin
                                         ScanTimer.Free;
                                         ScanTimer:=nil;
                                     end;
             end;
end;
{------------------}
procedure TKITScanner.DrawLeds;
var n:Integer;
begin
    LedH:=Height-Border-Border-2;
    if LedH<1
    then begin
                 Height:=3+Border+Border;
                 Draw;
             end;
    LedW:=(Width-Border-Border-1-FHowManyLeds) div FHowManyLeds;
    if LedW<1
    then begin
                 Width:=Border+Border+1+FHowManyleds*(2);
                 Draw;
             end;
    if (Width<>(Border+Border+1+FHowManyLeds*(1+LedW))) and
    ((Align=alLeft) or (Align=alRight) or (Align=alNone))
    then begin
                 Width:=Border+Border+1+FHowManyLeds*(1+LedW);
                 Draw;
             end;
    case FScanColor of
        scBlue      : begin
                                    FOutColor:=clNavy;
                                    FOnColor:=clBlue;
                                end;
        scGreen     : begin
                                    FOnColor:=clLime;
                                    FOutColor:=clGreen;
                                end;
        scRed       : begin
                                    FOutColor:=clMaroon;
                                    FOnColor:=clRed;
                                end;
        scYellow    : begin
                                    FOutColor:=clOlive;
                                    FOnColor:=clYellow;
                                end;
    end;

    Canvas.Brush.Color:=FOutColor;
    Ledx[1]:=Border+1;
    n:=2;
    while n<=FHowManyLeds
    do begin
             Ledx[n]:=Ledx[n-1]+1+LedW;
             Inc(n);
         end;
    for n:=1 to FHowManyLeds
    do Canvas.FillRect(Rect(Ledx[n],Border+1,Ledx[n]+LedW,Height-Border-1));
end;
{------------------}
procedure TKITScanner.UpdatePos;
begin
    case FScanMode of
        smBoth              : if LedWay
                                        then if LedPos>FHowManyLeds
                                                 then LedWay:=not LedWay
                                                 else Inc(LedPos,1)
                                        else if LedPos<1
                                                 then LedWay:=not LedWay
                                                 else Dec(LedPos,1);
        smLeftToRight : begin
                                            LedWay:=True;
                                            if LedPos>FHowManyLeds
                                            then LedPos:=0
                                            else Inc(LedPos,1);
                                        end;
        smRightToLeft : begin
                                            LedWay:=False;
                                            if LedPos<1
                                            then LedPos:=FHowManyLeds+1
                                            else Dec(LedPos,1);
                                        end;
    end;
end;

procedure TKITScanner.DoScan;
var n: Byte;
begin
    Canvas.Brush.Color:=FOutColor;
    for n:=1 to FHowManyLeds
    do Canvas.FillRect(Rect(Ledx[n],Border+1,Ledx[n]+LedW,Height-Border-1));
    UpdatePos;
    Canvas.Brush.Color:=FOnColor;
    if (LedPos>=1) and (LedPos<=FHowManyLeds)
    then Canvas.FillRect(Rect(Ledx[LedPos],Border+1,Ledx[LedPos]+LedW,Height-Border-1));
end;
{==============================================================================}
{Protected functions and procedures}


{==============================================================================}
{Public functions and procedures}
constructor TKITScanner.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);

    FBevelInner:=bvNone;
    FBevelOuter:=bvRaised;
    FBevelWidth:=1;
    FHowManyLeds:=7;
    FScanColor:=scRed;
    FScanSpeed:=100;
    FScanMode:=smBoth;

    LedPos:=1;
    LedWay:=True;

    Width:=82;
    Height:=12;
end;

destructor TKITScanner.Destroy;
begin
    if FScanning
    then SetScanning(False);
    inherited Destroy;
end;

procedure TKITScanner.Paint;
begin
    Draw;
end;
{==============================================================================}
procedure Register;
begin
    RegisterComponents('Samples', [TKITScanner]);
end;

end.